/*
 * Copyright (C) 2003,2004 Christopher J. Stawarz <cstawarz@cfa.harvard.edu>
 *
 * This file is part of SLglade.
 *
 * SLglade is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * SLglade is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with SLglade; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */

/* SLIRP header {{{
 * Parts of this file were generated by SLIRP, the (Sl)ang (I)nte(r)face
 * (P)ackage, a S-Lang module code generator for C, C++, and FORTRAN.
 *
 * Copyright (C) 2003-2004 Massachusetts Institute of Technology 
 * Copyright (C) 2002 Michael S. Noble <mnoble@space.mit.edu>
 *
 * This software was partially developed by the MIT Center for Space
 * Research under contract SV1-61010 from the Smithsonian Institution.
 * 
 * Permission to use, copy, modify, distribute, and sell this software
 * and its documentation for any purpose is hereby granted without fee,
 * provided that the above copyright notice appear in all copies and
 * that both that copyright notice and this permission notice appear in
 * the supporting documentation, and that the name of the Massachusetts
 * Institute of Technology not be used in advertising or publicity
 * pertaining to distribution of the software without specific, written
 * prior permission.  The Massachusetts Institute of Technology makes
 * no representations about the suitability of this software for any
 * purpose.  It is provided "as is" without express or implied warranty.
 * 
 * THE MASSACHUSETTS INSTITUTE OF TECHNOLOGY DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS.  IN NO EVENT SHALL THE MASSACHUSETTS
 * INSTITUTE OF TECHNOLOGY BE LIABLE FOR ANY SPECIAL, INDIRECT OR
 * CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
 * OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
 * NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
 * WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 }}} */

#include <stdlib.h>
#include <unistd.h>
#include <string.h>
#include <slang.h>

#if SLANG_VERSION < 20000

#define SLclass_get_class_id(x)	(x)->cl_data_type
#define SLang_get_error()	SLang_Error
#define SLang_set_error(x)	(SLang_Error = (x))
#define SLang_pop_double(x)	SLang_pop_double(x, NULL, NULL)
#define SLang_pop_uint		SLang_pop_uinteger
#define SLang_pop_int		SLang_pop_integer
#define SLang_push_uint		SLang_push_uinteger
#define SLang_push_int		SLang_push_integer
#define SLutf8_enable(x)	x

#ifdef __cplusplus
extern "C"
#endif
int _SLstack_depth(void);
#define SLstack_depth		_SLstack_depth

#endif
#include <glade/glade.h>
#define V				SLANG_VOID_TYPE
#define SLEU				SL_USAGE_ERROR
#define SLEI				SL_INTRINSIC_ERROR
#define SAFE_DEREF_OPAQUE(po)		(po == NULL ? NULL : po->instance)
#define SAFE_DEREF_ARRAY(pa)		(pa == NULL ? NULL : pa->data)
#define SLang_pop_string(x)             SLang_pop_slstring(x)
#define SLang_push_size_t		SLang_push_uint
#define SLang_push_ptrdiff_t		SLang_push_int
#define BEGIN_DECLS
#define END_DECLS

#define pop_defaultable(argno, kind, obj, value) \
   (SLang_Num_Function_Args >= argno ? SLang_pop_##kind (&obj) : ((obj = value) || &obj))



/*******************************************************************************
 *
 * SLIRP machinery
 *
 ******************************************************************************/


static void slirp_debug_pause(char *module_name)
{
   const char *var = getenv("SLIRP_DEBUG_PAUSE");
   if (var == NULL)
	return;
 {
   const char *prefix  = "slirp_debug_pause:";
   int length = atoi(var);

   if (module_name == NULL)
	module_name = (char*)"";

   if (length < 0) {
	length = abs(length);
	fprintf(stderr,"\n%s entered, ", prefix);
	fprintf(stderr,"will exit after %d second(s) ...\n",length);
	sleep(length);
	return;
   }

   fprintf(stderr,"\n%s %s module symbols have been loaded",prefix,module_name);
   fprintf(stderr,"\n%s set breakpoint(s) in debugger window, then",prefix);
   fprintf(stderr,"\n%s press any key in this window to continue\n",prefix);
   length = getchar();
 }
}

static void Slirp_usage_err(const char *usage_str)
{
   char msg[257];
   int npop = SLstack_depth();
   if (npop > SLang_Num_Function_Args)
	npop = SLang_Num_Function_Args;
   SLdo_pop_n(npop);
   snprintf(msg,248,"Usage: %s",usage_str);
   SLang_verror(SLEU, msg);
}
extern SLtype GtkOpaque_Type;
extern SLtype GObject_Type;
extern SLtype GdkDrawable_Type;
extern SLtype GdkGC_Type;
extern SLtype GdkPixbuf_Type;
extern SLtype GtkObject_Type;
extern SLtype GtkCellRenderer_Type;
extern SLtype GtkCellRendererPixbuf_Type;
extern SLtype GtkCellRendererText_Type;
extern SLtype GtkCellRendererToggle_Type;
extern SLtype GtkItemFactory_Type;
extern SLtype GtkTreeViewColumn_Type;
extern SLtype GtkTooltips_Type;
extern SLtype GtkAdjustment_Type;
extern SLtype GtkWidget_Type;
extern SLtype GdkCursor_Type;
extern SLtype GdkRegion_Type;
extern SLtype GtkIconSource_Type;
extern SLtype GtkIconSet_Type;
extern SLtype GtkTreeIter_Type;
extern SLtype GtkTextIter_Type;
extern SLtype GtkTreePath_Type;
#define SLIRP_EXTERN	extern
BEGIN_DECLS

#define SLIRP_ABI_VERSION			10500

typedef void            (*FINALIZER)            (void*);
typedef void            (*INITIALIZER)          (void*);

typedef struct _Slirp_Type {
   SLang_Class_Type	*slclass;	/* SLang type class for this type */
   struct _Slirp_Type	*parent;	/* NULL if type has no ancestors  */
   FINALIZER		finalizer;
   INITIALIZER		initializer;
} Slirp_Type;

typedef struct _Slirp_Opaque {
   Slirp_Type *type;
   void* instance;
   unsigned int owns_ref;
} Slirp_Opaque;


static int opaque_typecast (SLtype from_type, VOID_STAR from_p,
			unsigned int num, SLtype to_type, VOID_STAR to_p)
{
   unsigned int i;
   SLang_MMT_Type **from = (SLang_MMT_Type**)from_p;
   SLang_MMT_Type **to   = (SLang_MMT_Type**)to_p;

   (void) from_type; (void) to_type; 

   for (i=0; i < num; i++) {
	to[i] = from[i];	/* FIXME: typeof() still reports prev type */
	if (from[i] != NULL)
	   SLang_inc_mmt(from[i]);
   }

   return 1;
}

static int opaque_search(const void* key, const void *elem)
{
   return *(SLtype*)key - SLclass_get_class_id((*(Slirp_Type**)elem)->slclass);
}

static void destroy_opaque(SLtype type, VOID_STAR w)
{
   Slirp_Opaque *ot = (Slirp_Opaque*)w;

   (void) type;

   if (ot->type->finalizer != NULL)
      (*ot->type->finalizer) (ot->instance);

   SLfree( (char*)w );
}
END_DECLS

SLIRP_EXTERN SLtype void_ptr_Type;	/* These opaque pointer types must */
SLIRP_EXTERN SLtype string_ptr_Type;	/* be kept in sync with opaques.c  */
SLIRP_EXTERN SLtype uchar_ptr_Type;
SLIRP_EXTERN SLtype short_ptr_Type;
SLIRP_EXTERN SLtype ushort_ptr_Type;
SLIRP_EXTERN SLtype int_ptr_Type;
SLIRP_EXTERN SLtype uint_ptr_Type;
SLIRP_EXTERN SLtype long_ptr_Type;
SLIRP_EXTERN SLtype ulong_ptr_Type;
SLIRP_EXTERN SLtype float_ptr_Type;
SLIRP_EXTERN SLtype double_ptr_Type;
SLIRP_EXTERN SLtype opaque_ptr_Type;

typedef struct _Reserved_Opaque_Type {
   char	  *name;
   SLtype *type;		/* SLtype of opaque pointer defined by this */
   SLtype masked_type;		/* SLtype of datum to which this points */
} Reserved_Opaque_Type;

SLIRP_EXTERN Slirp_Type	**Slirp_Opaque_Types;
SLIRP_EXTERN SLtype 	Slirp_Num_Opaque_Types;
SLIRP_EXTERN SLtype	First_Opaque_Type;
SLIRP_EXTERN SLtype	Last_Reserved_Opaque_Type;

static Reserved_Opaque_Type Reserved_Opaque_Types[] = {

   { (char*)"void_ptr",		&void_ptr_Type,		SLANG_ANY_TYPE,    },
   { (char*)"int_ptr",		&int_ptr_Type,		SLANG_INT_TYPE,    },
   { (char*)"double_ptr",	&double_ptr_Type,	SLANG_DOUBLE_TYPE, },
   { (char*)"opaque_ptr",	&opaque_ptr_Type,	SLANG_ANY_TYPE,	   },
   { (char*)"float_ptr",	&float_ptr_Type,	SLANG_FLOAT_TYPE,  },
   { (char*)"long_ptr",		&long_ptr_Type,		SLANG_LONG_TYPE,   },
   { (char*)"string_ptr",	&string_ptr_Type,	SLANG_STRING_TYPE, },
   { (char*)"uint_ptr",		&uint_ptr_Type,		SLANG_UINT_TYPE,   },
   { (char*)"short_ptr",	&short_ptr_Type,	SLANG_SHORT_TYPE,  },
   { (char*)"ulong_ptr",	&ulong_ptr_Type,	SLANG_ULONG_TYPE,  },
   { (char*)"ushort_ptr",	&ushort_ptr_Type,	SLANG_USHORT_TYPE, },
   { (char*)"uchar_ptr",	&uchar_ptr_Type,	SLANG_UCHAR_TYPE,  },
   { NULL,		NULL,			0,		   }
};

#define NUM_RESERVED_OPAQUES \
	sizeof(Reserved_Opaque_Types) / sizeof(Reserved_Opaque_Type) - 1

static Slirp_Type* sltype_to_slirp_type(SLtype sltype)
{
   Slirp_Type **ot = (Slirp_Type**) bsearch( (const void*) &sltype,
	 		(const void*) Slirp_Opaque_Types,
			(size_t) Slirp_Num_Opaque_Types,
			sizeof(Slirp_Type*), opaque_search);
   return *ot;
}

static SLang_MMT_Type*
create_opaque_mmt(SLtype type, void *instance, unsigned int owns_ref)
{
   SLang_MMT_Type *mmt = NULL;
   Slirp_Opaque *ot = (Slirp_Opaque*) SLmalloc(sizeof(Slirp_Opaque));

   if (ot != NULL) {

	ot->instance = instance;
	ot->owns_ref = owns_ref;

	if ( (ot->type = sltype_to_slirp_type(type)) != NULL) {

	   if (ot->type->initializer != NULL)
		(*ot->type->initializer) (ot->instance);

	   mmt = SLang_create_mmt (type, (VOID_STAR) ot);
	}

	if (mmt == NULL)
	   SLfree((char*)ot);
   }

   return mmt;
}

static int SLang_push_opaque(SLtype type, void *instance, unsigned int owns_ref)
{
   SLang_MMT_Type *mmt;

   if (instance == NULL)
      return SLang_push_null();

   mmt = create_opaque_mmt(type, instance, owns_ref);
   if (NULL == mmt)
      return -1;

   return SLang_push_mmt(mmt);
}

static int SLang_pop_opaque(SLtype type, Slirp_Opaque **o, SLang_MMT_Type **mmt)
{
   Slirp_Opaque *ot;

   if (	(*mmt = SLang_pop_mmt(type)) != NULL &&
	(ot = (Slirp_Opaque*) SLang_object_from_mmt (*mmt)) != NULL &&
	ot->instance != NULL) {
	*o = ot;
	return 0;
   }

   SLang_free_mmt (*mmt);
   return -1;
}

static unsigned int
allocate_opaque(char *name, FINALIZER fzer, INITIALIZER izer, SLtype parent_id)
{
   /* Returning from here with anything but a positive id is fatal */
   SLtype new_type, ancestor_type;
   Slirp_Type *type , *parent = NULL;
   SLang_Class_Type *new_class = SLclass_allocate_class (name);

   if (new_class == NULL) return SLANG_UNDEFINED_TYPE;

   (void) SLclass_set_destroy_function (new_class, destroy_opaque);
   if (-1 == SLclass_register_class (new_class, SLANG_VOID_TYPE,
				     sizeof(Slirp_Opaque),
				     SLANG_CLASS_TYPE_MMT))
	return SLANG_UNDEFINED_TYPE;

   new_type = SLclass_get_class_id(new_class);
   if (parent_id) {

	type = parent = sltype_to_slirp_type(parent_id);

	while (type) {

	   ancestor_type = SLclass_get_class_id(type->slclass);

	   /* Support downcasting ancestor types to this type */
	   if (-1 == SLclass_add_typecast (ancestor_type, new_type,
		    					opaque_typecast, 1))
		return SLANG_UNDEFINED_TYPE;

	   /* Support upcasting this type to each ancestor type */
	   if (-1 == SLclass_add_typecast (new_type, ancestor_type,
							opaque_typecast, 1))
		return SLANG_UNDEFINED_TYPE;

	   type = type->parent;
	}
   }

   if ( (type = (Slirp_Type*) SLmalloc(sizeof(Slirp_Type))) == NULL)
	return SLANG_UNDEFINED_TYPE;

   type->slclass = new_class;
   type->parent = parent;
   type->finalizer = fzer;
   type->initializer = izer;
   Slirp_Opaque_Types[ Slirp_Num_Opaque_Types++ ] = type;

   return new_type;
}

static int allocate_reserved_opaque_types(void)
{
   Reserved_Opaque_Type *pt;
   long abi_version = -1;

   if ( SLang_is_defined((char*)"_slirp_initialized")) {

	if ( SLang_is_defined((char*)"_slirp_abi_version") == 0  ||
		SLang_load_string((char*)"_slirp_abi_version;") == -1 ||
		SLang_pop_long(&abi_version) == -1 ||
		abi_version < SLIRP_ABI_VERSION)
	{
	   SLang_verror(SLEU,
		(char*) "SLIRP abi mismatch: want version %ld, have %ld\n",
		(long)SLIRP_ABI_VERSION, abi_version);
	   return -1;
	}

	return 0;
   }

   (void)SLang_load_string((char*)"public variable _slirp_initialized=1;");
   (void)SLang_push_int(SLIRP_ABI_VERSION);
   (void)SLang_load_string((char*)"public variable _slirp_abi_version=();");

   Slirp_Num_Opaque_Types = 0;

   if ( NULL == (Slirp_Opaque_Types = (Slirp_Type**) SLmalloc
			( sizeof(Slirp_Type*) * (NUM_RESERVED_OPAQUES + 1))))
      return -1;

   Slirp_Opaque_Types[0] = NULL;

   pt = Reserved_Opaque_Types;
   while (pt->name != NULL) {
	if ((*pt->type = allocate_opaque(pt->name, NULL, NULL, 0)) ==
	      						SLANG_UNDEFINED_TYPE)
		return -1;
	   pt++;
	}

   /* Loop again, to enable casts to/from generic pointer type */
   pt = Reserved_Opaque_Types + 1;
   while (pt->name != NULL) {

	if (-1 == SLclass_add_typecast (*pt->type, void_ptr_Type,
							opaque_typecast, 1))
	   return SLANG_UNDEFINED_TYPE;

	if (-1 == SLclass_add_typecast (void_ptr_Type, *pt->type,
							opaque_typecast, 1))
	   return SLANG_UNDEFINED_TYPE;

	pt++;
   }

   First_Opaque_Type = *Reserved_Opaque_Types[0].type;
   Last_Reserved_Opaque_Type = First_Opaque_Type + NUM_RESERVED_OPAQUES - 1;

   return 0;
}
static int pop_obj_or_null(SLtype type, void **obj, void **meta)
{
   if (SLANG_NULL_TYPE == SLang_peek_at_stack ()) { 
	*obj = NULL;
	if (type && meta != NULL)
	   *meta = NULL;
	return SLang_pop_null ();
   }

   switch(type) {

	case 0:
	   return SLang_pop_cstruct(*obj, (SLang_CStruct_Field_Type *)meta);

	case SLANG_ANY_TYPE:
	   return SLang_pop_anytype((SLang_Any_Type**)obj);

	case SLANG_REF_TYPE:
	   return SLang_pop_ref((SLang_Ref_Type**)obj);

	case SLANG_STRING_TYPE:
	   return SLang_pop_slstring ((char**)obj);

	default:
	   /* This will fail, as intended, for non-opaque types */
	   return SLang_pop_opaque(type, (Slirp_Opaque**)obj,
		 				(SLang_MMT_Type **)meta);
   }
}
#define pop_string_or_null(s)  pop_obj_or_null(SLANG_STRING_TYPE,(void**)s,NULL)
#define pop_ref_or_null(r)     pop_obj_or_null(SLANG_REF_TYPE,(void**)r,NULL)
#define pop_anytype_or_null(a) pop_obj_or_null(SLANG_ANY_TYPE,(void**)a,NULL)

SLtype GladeXML_Type;

/*
 * Finalizer to be called when GladeXML objects go out of scope
 */
static void slglade_xml_destroy(GladeXML *xml) {
   g_object_unref(G_OBJECT(xml));
}

static int allocate_glade_opaque_types(void)
{
   Slirp_Opaque_Types = (Slirp_Type**) SLrealloc((char*)Slirp_Opaque_Types,
		(1 + Slirp_Num_Opaque_Types + 1) * sizeof(Slirp_Type*));

   if (Slirp_Opaque_Types == NULL) return -1;

   GladeXML_Type = allocate_opaque((char*)"GladeXML",
		(FINALIZER) slglade_xml_destroy, 
		(INITIALIZER) NULL,
		(SLtype) GObject_Type);
   if (GladeXML_Type == SLANG_UNDEFINED_TYPE) return -1;

   return 0;
}



/*******************************************************************************
 *
 * Intrinsic constants and variables
 *
 ******************************************************************************/


/* SLGLADE_VERSION_STRING, SLGLADE_VERSION_NUMBER, and
 * SLGLADE_DOC_DIR are defined at compile time */

static char *slglade_version_string = SLGLADE_VERSION_STRING;
static char *slglade_doc_dir = SLGLADE_DOC_DIR;

static SLang_IConstant_Type glade_IConsts[] = 
{
  MAKE_ICONSTANT("_glade_module_version", SLGLADE_VERSION_NUMBER),
  SLANG_END_ICONST_TABLE
};

static SLang_Intrin_Var_Type glade_IVars[] =
{
  MAKE_VARIABLE("_glade_module_version_string", &slglade_version_string,
    SLANG_STRING_TYPE, 1),
  MAKE_VARIABLE("_glade_module_doc_dir", &slglade_doc_dir,
    SLANG_STRING_TYPE, 1),
  SLANG_END_INTRIN_VAR_TABLE
};



/*******************************************************************************
 *
 * Internal functions and data structures
 *
 ******************************************************************************/


/*
 * Instead of writing our own closure mechanism for connecting
 * signal handlers, we use the one from SLgtk.  These two
 * functions come from slglib.c.
 *
 * This does make for a pretty ugly dependency on the internals
 * of SLgtk, but oh well ...
 */
extern int extract_slang_args(unsigned int nargs, SLang_Any_Type ***pargs);
extern GClosure* slg_closure_new(SLang_Name_Type *function,
                                 SLang_Any_Type **args, unsigned int nargs,
				 SLang_Any_Type *swap_data);


/*
 * Data structure for passing handler-function info
 */
typedef struct {
   SLang_Name_Type *function;	/* S-Lang function to handle signal */
   SLang_Any_Type **args;	/* Function args passed in from S-Lang scope */
   unsigned int  nargs;		/* Number of args */
} signal_connect_data;


/*
 * GladeXMLConnectFunc for use with glade_xml_signal_connect_full()
 * and glade_xml_signal_autoconnect_full().  (I figured out how to
 * make this work by studying examples in libglade and SLgtk.)
 */
static void
signal_connect_connect_func(const gchar *handler_name, GObject *object,
			    const gchar *signal_name, const gchar *signal_data,
			    GObject *connect_object, gboolean after,
			    gpointer user_data)
{
   /* glade_xml_signal_connect_full() and glade_xml_signal_autoconnect_full()
    * both pass NULL for signal_data, so there's no need to worry about it. */

   char *handler;
   signal_connect_data *data = (signal_connect_data *)user_data;
   SLang_Name_Type *function = NULL;
   SLang_Any_Type *conn_obj;

   /*
    * Retrieve the S-Lang function to connect as signal handler
    */

   if (data->function) {
      function = data->function;
   } else {
      /* Make a copy of handler_name so that the compiler doesn't complain
       * that we're passing a const pointer to a function (SLang_get_function)
       * that takes a non-const argument */
      handler = SLmalloc((strlen(handler_name) + 1) * sizeof(char));
      strcpy(handler,handler_name);

      function = SLang_get_function(handler);

      if (function == NULL) {
         SLang_vmessage(
	   "SLglade: WARNING: cannot find function matching name \"%s\"",
	   handler);
      }

      SLfree(handler);
   }

   /*
    * Connect the handler
    */

   if (function == NULL) {
      SLang_vmessage("SLglade: WARNING: cannot connect handler function to "
	"signal \"%s\" on widget \"%s\"", signal_name,
	glade_get_widget_name((GtkWidget *)object));
   } else {
      if (connect_object == NULL) {
         /* No connect_object was specified, so when called, the
	  * handler will be passed the object that generated the signal */

         g_signal_connect_closure(object, signal_name,
           slg_closure_new(function,data->args,data->nargs,NULL), after);
      } else {
         /* connect_object specified, so the handler will be passed this
	  * object instead of the one that generated the signal.
	  * (This occurs when an object name is specified with the
	  * signal handler in Glade.  The effect is like that of
	  * g_signal_connect_swapped().) */

         /* I guessed that connect_object should be the swap_data in the
	  * slGClosure based on an examination of the functions
	  * pyg_closure_new() in pygtype.c and pygobject_connect_object()
	  * in pygobject.c of the pygtk-2.0.0 distribution and the description
	  * of g_signal_connect_swapped() in the GTK+ API docs.  This seems to
	  * work, so I think I'm right. */

	 /* This looks a bit hackish (pushing the GObject onto the stack and
	  * then immediately popping it off), but it seems like the easiest way
	  * to typecast from GObject to Any_Type. */

         /* Probably ought to check for failure here, but I don't know how
	  * this could fail */
         SLang_push_opaque(GObject_Type, connect_object, 0);
	 SLang_pop_anytype(&conn_obj);

         g_signal_connect_closure(object, signal_name,
           slg_closure_new(function,data->args,data->nargs,conn_obj),
	   (after ? G_CONNECT_AFTER : 0) | G_CONNECT_SWAPPED);
      }
   }
}



/*******************************************************************************
 *
 * Intrinsic functions
 *
 ******************************************************************************/


/*
 * glade_get_widget_tree()
 */
static void sl_glade_get_widget_tree (void)
{
   GladeXML* result;
   Slirp_Opaque* arg1 = NULL;
   SLang_MMT_Type *mmt_arg1 = NULL;

   if (SLang_Num_Function_Args != 1 ||
	SLang_pop_opaque(GtkWidget_Type, &arg1, &mmt_arg1) == -1 )
	{Slirp_usage_err("GladeXML = glade_get_widget_tree(GtkWidget)"); return;}

   result = glade_get_widget_tree((GtkWidget*) SAFE_DEREF_OPAQUE(arg1));

   /* Since this function creates a new GladeXML object in S-Lang scope, we
    * need to increase the reference count to the C-scope GladeXML object */
   g_object_ref(G_OBJECT(result));

   SLang_free_mmt(mmt_arg1);
   (void) SLang_push_opaque(GladeXML_Type,  result, 0);
}


/*
 * glade_xml_new_from_buffer()
 *
 * I don't know if this would ever be useful from S-Lang scope, but we'll wrap
 * it anyway.
 */
static void sl_glade_xml_new_from_buffer (void)
{
   GladeXML* result;
   char* buffer;
   char* root = NULL;
   char* domain = NULL;

   int status = 0;  /* Error status */

   switch (SLang_Num_Function_Args) {
      case 3:
        status += pop_obj_or_null(SLANG_STRING_TYPE, (void**)&domain, NULL);
      case 2:
	status += pop_obj_or_null(SLANG_STRING_TYPE, (void**)&root, NULL);
      case 1:
	status += SLang_pop_string(&buffer);
	break;
      default:
	status = -1;
	break;
   }

   if (0 != status)
	{Slirp_usage_err("GladeXML = glade_xml_new_from_buffer(string[,string[,string]])"); return;}

   result = glade_xml_new_from_buffer(buffer, (int)strlen(buffer), root,
     domain);
   (void) SLang_push_opaque(GladeXML_Type,  result, 0);
}


/*
 * glade_xml_get_widget_prefix()
 *
 * Since a GList wouldn't be very useful in S-Lang scope, we return an array
 * of GtkWidget's instead.
 */
static void sl_glade_xml_get_widget_prefix (void)
{
   GList* result;
   Slirp_Opaque* arg1 = NULL;
   SLang_MMT_Type *mmt_arg1 = NULL;
   char* arg2;

   SLang_Array_Type *rtn_array;
   SLang_MMT_Type *wdg_mmt;
   int array_count;

   if (SLang_Num_Function_Args != 2 ||
	pop_obj_or_null(SLANG_STRING_TYPE, (void**)&arg2, NULL)== -1 ||
	SLang_pop_opaque(GladeXML_Type, &arg1, &mmt_arg1) == -1 )
	{Slirp_usage_err("GtkOpaque = glade_xml_get_widget_prefix(GladeXML,string)"); return;}

   /* Treat a NULL name as the empty string */
   if (arg2 == NULL)  arg2 = SLang_create_slstring("");

   result = glade_xml_get_widget_prefix((GladeXML*) SAFE_DEREF_OPAQUE(arg1), arg2);
   SLang_free_mmt(mmt_arg1);

   if (result == NULL) {
      /* No matching widgets, so return NULL */
      SLang_push_null();
      return;
   }

   /*
    * Found some matching widgets, so make the array to return
    */

   array_count = g_list_length(result);
   rtn_array = SLang_create_array(GtkWidget_Type, 0, NULL, &array_count, 1);

   if (rtn_array == NULL)  return;

   array_count = 0;

   while (result != NULL) {
      wdg_mmt = create_opaque_mmt(GtkWidget_Type, (GtkWidget *)result->data, 0);

      if (-1 == SLang_set_array_element(rtn_array, &array_count, &wdg_mmt)) {
         SLang_free_array(rtn_array);
         return;
      }

      /* We should NOT call SLang_free_mmt() here -- it causes a seg fault */

      result = result->next;
      array_count++;
   }

   (void) SLang_push_array (rtn_array, 1);
}


/*
 * glade_require()
 *
 * Another one that probably won't be useful from S-Lang scope, but let's wrap
 * it anyway.
 */
static void sl_glade_require (void)
{
   char* arg1;

   if (SLang_Num_Function_Args != 1 ||
	SLang_pop_string(&arg1) == -1 )
	{Slirp_usage_err("glade_require(string)"); return;}

   glade_require(arg1);
}


/*
 * glade_xml_signal_connect()
 *
 * The mechanics of this are modeled off one of the signal-connection functions
 * in SLgtk (I forget which one).
 */
static void sl_glade_xml_signal_connect (void)
{
   Slirp_Opaque *xml_self;
   char *handlername = NULL;
   SLang_Ref_Type *function_ref = NULL;
   signal_connect_data data;

   SLang_MMT_Type *mmt = NULL;
   SLang_Name_Type *function;
   SLang_Any_Type **args = NULL;
   unsigned int nargs = 0;

   nargs = SLang_Num_Function_Args - 3;

   if (SLang_Num_Function_Args < 3 ||
        extract_slang_args(nargs,&args) == -1 ||
        SLang_pop_ref(&function_ref) == -1 ||
        SLang_pop_string(&handlername) == -1 ||
	SLang_pop_opaque(GladeXML_Type, &xml_self, &mmt) == -1 ||
        NULL == (function = SLang_get_fun_from_ref(function_ref)))
	{Slirp_usage_err("glade_xml_signal_connect(GladeXML,string,function_ref[,data,...])"); return;}

   data.function = function;
   data.args = args;
   data.nargs = nargs;

   glade_xml_signal_connect_full((GladeXML *)SAFE_DEREF_OPAQUE(xml_self),
     handlername, signal_connect_connect_func, &data);

   SLang_free_mmt(mmt);
}


/*
 * glade_get_widget_name()
 */
static void sl_glade_get_widget_name (void)
{
   const char* result;
   Slirp_Opaque* arg1 = NULL;
   SLang_MMT_Type *mmt_arg1 = NULL;

   if (SLang_Num_Function_Args != 1 ||
	SLang_pop_opaque(GtkWidget_Type, &arg1, &mmt_arg1) == -1 )
	{Slirp_usage_err("string = glade_get_widget_name(GtkWidget)"); return;}

   result = glade_get_widget_name((GtkWidget*) SAFE_DEREF_OPAQUE(arg1));
   SLang_free_mmt(mmt_arg1);
   (void) SLang_push_string ((char*) result);
}


/*
 * glade_xml_get_widget()
 */
static void sl_glade_xml_get_widget (void)
{
   GtkWidget* result;
   Slirp_Opaque* arg1 = NULL;
   SLang_MMT_Type *mmt_arg1 = NULL;
   char* arg2;

   if (SLang_Num_Function_Args != 2 ||
	SLang_pop_string(&arg2) == -1 ||
	SLang_pop_opaque(GladeXML_Type, &arg1, &mmt_arg1) == -1 )
	{Slirp_usage_err("GtkWidget = glade_xml_get_widget(GladeXML,string)"); return;}

   result = glade_xml_get_widget((GladeXML*) SAFE_DEREF_OPAQUE(arg1), arg2);

   /* Since this function creates a new GtkWidget object in S-Lang scope, we
    * need to increase the reference count to the C-scope GtkWidget object */
   /* Actually, since SLgtk appears not to assign a finalizer to GtkWidgets
    * (meaning there won't be a corresponding call to gtk_widget_unref()),
    * maybe I shouldn't do this */
   /*gtk_widget_ref(result);*/

   SLang_free_mmt(mmt_arg1);
   (void) SLang_push_opaque(GtkWidget_Type,  result, 0);
}


/*
 * glade_xml_signal_autoconnect()
 */
static void sl_glade_xml_signal_autoconnect (void)
{
   Slirp_Opaque *xml_self;
   signal_connect_data data;

   SLang_MMT_Type *mmt = NULL;

   if (SLang_Num_Function_Args != 1 ||
	SLang_pop_opaque(GladeXML_Type, &xml_self, &mmt) == -1 )
	{Slirp_usage_err("glade_xml_signal_autoconnect(GladeXML)"); return;}

   data.function = NULL;
   data.args = NULL;
   data.nargs = 0;

   glade_xml_signal_autoconnect_full((GladeXML *)SAFE_DEREF_OPAQUE(xml_self),
     signal_connect_connect_func, &data);
   SLang_free_mmt(mmt);
}


/*
 * glade_xml_new()
 *
 * We search for the input file first in the current directory, then along
 * SLGLADE_XML_PATH, and finally along S-Lang's load path.
 */
static void sl_glade_xml_new (void)
{
   GladeXML* xml;
   char* fname;
   char* root = NULL;
   char* domain = NULL;

   char* file = NULL;		/* Full path to file */
   char* sl_path = NULL;	/* S-Lang load path */

   int status = 0;		/* Error status */

   switch (SLang_Num_Function_Args) {
      case 3:
        status += pop_obj_or_null(SLANG_STRING_TYPE, (void**)&domain, NULL);
      case 2:
	status += pop_obj_or_null(SLANG_STRING_TYPE, (void**)&root, NULL);
      case 1:
	status += SLang_pop_string(&fname);
	break;
      default:
	status = -1;
	break;
   }

   if (0 != status)
	{Slirp_usage_err("GladeXML = glade_xml_new(string[,string[,string]])"); return;}

   /*
    * Search for XML file using SLpath_find_file_in_path()
    *
    * Note that it's safe to pass NULL as the path argument to this
    * function (it will return NULL)
    */

   /* First, look in current directory */
   file = SLpath_find_file_in_path(".", fname);

   /* Second, search along SLGLADE_XML_PATH */
   if (NULL == file)
      file = SLpath_find_file_in_path(getenv("SLGLADE_XML_PATH"), fname);

   /* Third, search along S-Lang load path */
   if (NULL == file) {
      sl_path = SLpath_get_load_path();
      file = SLpath_find_file_in_path(sl_path, fname);
      SLang_free_slstring(sl_path);
   }

   /*
    * Load XML file
    */

   if (NULL != file) {
      /* Found file with SLpath_find_file_in_path(), so load it */
      xml = glade_xml_new(file,root,domain);
      SLfree(file);
   } else {
      /* Didn't find file, so pass the input name to libglade;
       * presumably, it will just fail, but this saves us the trouble of
       * printing an error message */
      xml = glade_xml_new(fname,root,domain);
   }

   (void) SLang_push_opaque(GladeXML_Type, xml, 0);
}


static SLang_Intrin_Fun_Type glade_Funcs [] =
{
   MAKE_INTRINSIC_0((char*)"glade_get_widget_tree",sl_glade_get_widget_tree,V),
   MAKE_INTRINSIC_0((char*)"glade_xml_new_from_buffer",sl_glade_xml_new_from_buffer,V),
   MAKE_INTRINSIC_0((char*)"glade_xml_get_widget_prefix",sl_glade_xml_get_widget_prefix,V),
   MAKE_INTRINSIC_0((char*)"glade_require",sl_glade_require,V),
   MAKE_INTRINSIC_0((char*)"glade_xml_signal_connect",sl_glade_xml_signal_connect,V),
   MAKE_INTRINSIC_0((char*)"glade_get_widget_name",sl_glade_get_widget_name,V),
   MAKE_INTRINSIC_0((char*)"glade_xml_get_widget",sl_glade_xml_get_widget,V),
   MAKE_INTRINSIC_0((char*)"glade_xml_signal_autoconnect",sl_glade_xml_signal_autoconnect,V),
   MAKE_INTRINSIC_0((char*)"glade_xml_new",sl_glade_xml_new,V),
   SLANG_END_INTRIN_FUN_TABLE
};



/*******************************************************************************
 *
 * Module initialization
 *
 ******************************************************************************/


BEGIN_DECLS
#define   SLIRP_VERSION	10500
SLANG_MODULE(glade);
int init_glade_module_ns(char *ns_name)
{
   SLang_NameSpace_Type *ns = NULL;

   /* Before doing anything, check that SLgtk has been loaded */
   if (-1 != SLang_is_defined("_slgtk_version_string")) {
	SLang_verror(SL_INTRINSIC_ERROR, "gtk module has not been loaded");
	return -1;
   }

   if (ns_name != NULL) {
	ns = SLns_create_namespace (ns_name);
	if (ns == NULL) return -1;
   }

   slirp_debug_pause((char*)"glade");
   allocate_reserved_opaque_types();

   if (allocate_glade_opaque_types() == -1) return -1;
   if (-1 == SLns_add_iconstant_table(ns, glade_IConsts, NULL))
	return -1;
   if (-1 == SLns_add_intrin_var_table(ns, glade_IVars, NULL))
	return -1;
   if (-1 == SLns_add_intrin_fun_table( ns, glade_Funcs, (char*)"__glade__"))
	return -1;

   return 0;
}
END_DECLS
